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DRMASTER 
Version ‘v04-000' 


PARRRRARARASALARAAARARALARALALAASASAASALESESE SELES SESE RARE ARRAS ERA R ESRC SEES 


COPYRIGHT («) 1978, 1980, 1982, 1984 BY 
DIGITAL EQUIPMENT 1 CORPORATION, MAYNARD, MASSACHUSETTS. 
ALL RIGHTS” RESERVED . 


® 
® 
¥ 
® 
THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED * 
ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE ®* 
INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER * 
COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY * 
OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY * 
TRANSFERRED. * 
® 
THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE 
AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT * 
CORPORATION. * 
& 
® 
® 
® 
® 
* 


DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR _ RELIABILITY OF ITS 
SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. 
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FACILITY: DRCOPY -- EXAMPLE PROGRAM FOR DR32 


ABSTRACT: 
This set of routines constitutes a Master portion of the 
DRCOPY file transfer example prog 
For more information on the D 35° oe how it is eyrper tes by 


VAX/VMS, see Chapter 11 of the VAX/VMS 1/0 Users’ Guide. 
ENVIRONMENT: ; 

These programs run in User mode; no privileges are needed. 
AUTHOR: Steve Beckhardt, CREATION DATE: July, 1979 
MODIFIED BY: 

- : VERSION 
01 = 


POOOVOAIOAIAIAIOIAAIAIAIAIOIAIGA ABOMAAIAIGAIDGOIAOAIAAOAOAOOAAAAAOOOOO 
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TO RUN DRCOPY: 


ARRRRRARBRAAAARAALARAAAAASALASASALESALELELE SEES E SESE CESSES CEES SECC CESSES EES a a 


DRCOPY requires two CPUs and two DR32s; the DR32s form the 
communications path between the two CPUs. 
To run DRCOPY, type the following commands on BOTH CPUs: 


$ SET DEFAULT SYSSSYSDISK:CSYSHELP.EXAMPLES) 
$ @DRCOPYBLD ! if necessary, to create image file. 
$ RUN DRCOPY 


A prompt, "‘DRCOPY>"', should appear. To get a description of the valid 
DRCOPY file transfer commands, oe ‘HELP’' in response to the proses. 
; In order to use DRCOPY, both CPUs must be running the DRCOPY program 
(i.e. a terminal on each CPU should be waiting at the “DRCOPY>’’ prompt). 


PPPS PSPS SP PP PPP iri iii titi t tit iii titi iiiiii titi it) 
THE FOLLOWING SECTIONS ARE INCLUDED AS AN AID TO UNDERSTANDING THE 
IMPLEMENTATION OF THE DRCOPY PROGRAM. 


ARR RARARRRARAAALALAASALALALLL LEAS ALE LESSEE EEE EEE ETERS SESE SESE Cee See eee e Tas 


This set of routines is used to implement a CPU - to = CPU file 
transfer protocol using the DR32. The goals are to implement the 
proteces (excluding the data source and data sink routines) in 

ORTRAN, using the bverery of high-level support routines provided 
in VMS Release 2 for the DR780.**** Please read Chapter 11 of the VAX/VMS 
1/0 User's Guide before trying to understand this material. **** 


THE MASTER ROUTINES AND THE SLAVE ROUTINES 


In DRCOPY's model of the world, there exists a Master program 
in one CPU and a Slave program in the other. The Master euage 
initiates file transfers, and the direction of the file transfers are 
defined from the Master's point of view (i.e. a ‘read’ or a ‘get' 
operation means ‘transfer a file from the Slave to the Master’, while 
. ar or a ‘write’ operation transfers a file from the Master to the 

ave). 

While it is convenient to think of one CPU as the ‘Master'', and the 
other as the ‘'Slave’’, in reality both images of DRCOPY contain a set of 
routines that are collectively called the Master routines and a set of 
routines called the Slave routines. oyr ine discussions of a transfer, the 
Master CPU is the CPU currently executing the Master routines; the Slave CPU 
is perventts executing the Slave routines. But since both images contain 


both sets of routines, either CPU can pocent tasty be the Master or the Slave; 
in fact, both CPUs can be Master and Slave simultaneously. 
DRCOPY on CPU A DRCOPY on CPU B 
tm@wmwwerwwwwowowwwmw oe hh ee se se Se ee se ce ce ca ce 
MASTER ee MASTER 
routines ‘ \V/ routines 


Peemewwwwww~ww Ge 4 he ee ce ee ce ce 
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The files being tranferred are assumed to be on disk, and too big 
(or too Se to be locked down into memory during the transfer, so 
they are buffered in main memory. The ‘source’ side of any given transfer 
(the Master during a PUT and the Slave during a GET) is involved in two 
yearns processes: (1) filling at ring of buffers from disk; and 
( shipping filled buffers via the DR32 to the far-end CPU, 

The receiving side is in turn: (1) obtaining buffers full of data from 
the far-end CPU and (2) emptying the buffers back out to its own disk. The 
transfer of data between disk and memory will be called the RMS process; 
the transfer of data from one CPU's memory to the other's will be called the 
DR-transfer process. 


THE MAIN ROUTINES 


PARSE \ 
GET_TOKEN = command interface routines 
HELP / 


DO_PUT <-Top level Master routine for copying a file from local CPU 
to remote CPU. 


DO_GET <-Top level Master routine for copying a file from remote CPU 
to local CPU. 


THE AST ROUTINES 


MRMS_AST -Master RMS AST completion routine 
SLV_BUFDONE -Slave RMS AST completion routine 


PKT_AST -Called when a completed DR32 command pocket is Pieces on an 
aoetr termination queue. Call XFSGETPKT until TERMQ is onpty. 
XFSGETPKT will call the action routine associated with eac 
packet as it removes that packet from TERMQ. 


THE ACTION ROUTINES 


When building command packets, the Master routines specify different 
action routines depending on the function this command packet will 
perform. The Master also specifies a special action routine for 
command packets that it loads on the free queue. 


ACT_NOPPKT Mt po ony when a command packet specifying a NOP function 
completes. 
ACT_RWPKT “fal led when a read or write packet completes. 


ACT_FREQUE -This is tiie action routine address built into packets 
released onto the free queue; it is called after the DR32 
stores a command/device message from the far-end device 
into a packet from the free queue and then inserts that 
packet onto the termination queue. 


| 


DRM 


QOOn 


OOO 


800 
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According to the protocol defined for DRCOPY, the first longword of all | 
device aseenges is a type code. ACT_FREQUE dispatches to the routine 
associated with each type code. The type codes fall into two main 
categories: those whose names begin with MS_MSG are messages from the 
Master to the Slave; those whose names begin with SM_MSG are messages | 
from the Slave to the Master. for instance, the type code 
MS_MSG_STARTPUT is a message from the Master informing the Slave that 
a PUT Speration is to be initiated. | 


Slave routines are only invoked in response to device messages from the 
Master side. (There is one exception to this: after a message from the 
Master starts up the Slave's RMS process, that process proceeds without 
coordination from the Master while there are buffers available to it.) 
The Slave routines respond to device messages from the far-end Master 
routines, but require the local Master routines to remove the packet 
(containing the far-end device message) from the termination queue 
and to call the appropriate Slave routine according to the type of 

device message. 


SLAVE FREE QUEUE ROUTINES (SFQ_) 


SFQ_STARTGET -Calied when the Slave receives an MS_MSG_STARTGET 
message; Slave opens the file and sends its attributes 
back to the Master. Slave also sends the addresses of 
its buffers. t 
SFQ_GOGET -Called when Master signals that he received file attributes, 
opened the file, and is ready to accept data; Slave issues 
an RMS read to get patogs going. 
SFQ_STARTPUT -Called when the Slave receives an MS_MSG_STARTPUT 
message; Slave creates the file, sends back the addresses 


of its buffers, and waits for data from Master. 
SFQ_PNXTBFR -Called when the Slave receives a ‘‘process your next 

uffer’’ message. : : 
SFQ_PLSTBFR -This message is only sent ag a PUT operation; it means 

the last buffer to be written to disk has arrived. 


MASTER FREE QUEUE ROUTINES (MFQ_) 


| 
| 
BFRADS -Process List of buffer addresses sent by Slave. 
FILEATTR coOPy attributes of file opened by Slave. 
PNXTBFR -Called when Slave sends message that it has processed 

another buffer; this means another buffer is available 

to the Master. 
MFQ_PLSTBFR -Called when Slave sends a message that it has processed 

its last buffer; if GET, read last buffer; if PUT, 


transfer is complete - wake main level. 
MFQ_ERROR -Called when Slave sends error message. 


POAVOOVOIOADADAASPIAAYAOSIAOYIASAAIOAIAIAAIAAGIAAIAOAIAOGAAIAIADAAOAAAOOAAOAAOOA0OO 


OOa 


OOO 


DRMASTER.FOR; 1 


DRMASTER =~ the Master portion of the DRCOPY example program 


INCLUDE ‘SYSSLIBRARY:XFDEF.FOR/NOLIST’ ! DR32 definitions 
INCLUDE ‘DRCOPY.PRM' ! Parameters 

Local Variables 

INTEGER*®4 STATUS 


Common variab.es and areas 
CHARACTER*80 INPLINE ! Input Line 
CHARACTER*64 LOC_FNAME ' Local file name 
CHARACTER*64 REM_FNAME ! Remote file name 
COMMON /CHARS/ INPLINE,LOC_FNAME ,REM_F NAME 

INTEGER*2 LOC_FNSIZE 


INTEGER*2 REM FNSIZE 
sPos ! starting token pos. 
INTEGER*2 EPOS ! Ending token pos. 


COMMON /SIZES/ LOC_FNSIZE,REM_FNSIZE,SPOS,EPOS 
INTEGER*4 XFDATA(30) 

BYTE MBFRS(BUFSIZ,NUM_MBFRS) 

BYTE SBFRS(BUFSIZ,NUM_SBFRS) 

COMMON /MS_SHARE/ XFDATA,MBFRS,SBFRS 


INTEGER*®4 IDEVMSG(32) 


' Local file name size 
' Remote file name size 


Context array 
Master buffers 
Slave buffers 


! Incoming device messages 
} gutgotne device messages 
! Remote buffer addresses 
' File attributes 

' Common status 

' Last buffer size 

' DDI disable 

' Master RAS count 

' Master RMS index 

' Queve packet count 

' Queue packet index 

' Remote buffer count 

' Remote buffer index 

! Number of remote buffers 
! Get/put flag 

' Last buffer flag 

! End of file flag 

' Error flag 

! Remote error flag 


LOGICAL®1 REMFLAG 

COMMON /MDATA/ IDEVMSG,ODEVMSG,REM_BFRADS,FILEATIR, CSTATUS 

1 LASTBFRSIZ,DDIDIS,MRMS_CNT.MRMS_IDX,QPKT CNT, 
2 OPKT_IDX,REM_CNT,REM_IDX,NUMREM-BFRS,GPFCAG, 
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OOOO 


GOOOOO 


ROO 


LASTBFR,EOFFLAG, ERRFLAG,REMFLAG 


3 

INTEGER®4 SYSSCLREF 
INTEGER®4 SYSSSETEF 
INTEGER®4 SYSSWAITFR 
EXTERNAL ACT_FREQUE 
EXTE 
EXTE 


RNAL ACT_NOPPKT 
RNAL PKT_AST 


Set event nee 2. This is used by the slave half to indicate 
when it is active so that we don't exit while the slave is active. 


STATUS = SYSSSETEF (ZVAL(5)) 
IF (.NOT. STATUS) CALL FATAL_ERROR(STATUS) 


Start the DR32. This involves three calls. One to set 

up everything, one to initialize the free pee with empty 
packets, and one to actually start the DR32. 

CALL XFSSETUP(XFDATA, Context array 
1 MBFRS Data buffers 


' 
! 
¢ BUF SIZ, ! Data buffer size 
NUM _MBFRS + NUM_SBFRS, ! Number of data buffers . 
4 IDEVMSG,128, ! Incoming device msg array and size 
5 ‘ ! No log are 
6 §fAtus) i Status 
IF (.NOT. STATUS) CALL FATAL_ERROR(STATUS) 
CALL XFSFREESET(XFDATA, ' Context array 
1 NUM_MBFRS + NUM_SBFRS, ! Number of Free Q packets 
2 . ! AST if Term Q empty 
3 ACT_FREQUE,, ! Action routine, no param. 
4 ! Status 
IF (.NOT. STATUS) CALL FATAL_ERROR(STATUS) 
CALL XFSSTARTDEV(XFDATA, ' Context array 
1 *XFAO:*, ' Device name 
§ PKT_AST,... ! AST routine 
DATARATE, ! Data rate 
4 STAT ! Status 
IF (.NOT. STATUS) CALL FATAL_ERROR(STATUS) 


Enable random access mode (device initiated transfers) 


STATUS = SYSSCLREF(ZVAL(1)) ! Clear event flag 
IF (.NOT. STATUS) CALL FATAL_ERROR(STATUS) 


CALL XFSPKTBLD(XFDATA, 
1 XFSK_PKT_SETRND, ! Set random enable 


2 eervnve 
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3 64+256 ! Ins @ head, Int. if empty 
4 ACT_NOPPKT,, i Action routine, parm 

5 STATUS) i Status 

IF (.NOT. STATUS) CALL FATAL -ERROR (STATUS) 

STATUS = SYSS$W WAITER( VAL(1))~ Wait for packet 

IF (.NOT. STATUS) CALL FATAL _ERROR(STATUS)” 


Get the command 


Ls fF . ! Prompt for input 

READ(5 1 Bae £RD~8006) INPLINE ! Get input Line 

FORMAT (ABS 

CALL PARSE (GPFLAG) ' Parse it 

IF (.NOT. GPFLAG) GO 50 ' No command, r repens 
WRITE(6,700)GPFLAG,LOC_FNAME (1 LOC_FNSIZE) “REN. — REM_FNSIZE) 
FORMAT (Ix, AG = ',T1,' OCAL~FILE NAME = 

e .*.. 2 MOTE FILE NAME = A) 


Do the requested operation 


IF (GPFLAG .EQ. 1) THEN 
CALL DO_GET 


CALL DO_PUT 
END IF 
GO TO 500 
Wait until slave half finishes before exiting 


STATUS = SYSSWAITFR(ZVAL(5)) 
IF (.NOT. STATUS) CALL FATAL_ERROR(STATUS) 


END 
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SUBROUTINE PARSE (GPFLAG) 


This subroutine parses the input Line into a command, 
a local filename, and a remote filename. 


Local Variables 
INTEGER®4 GPFLAG ! Get/Put flag 


Common variables and areas 


CHARACTER*80 tte th ' Input Line 
CHARACTER*64 LOC_FNAME ' Local file name 
CHARACTER®64 REM_FNAME i Remote file name 


COMMON /CHARS/ INPLINE,LOC_FNAME,REM_FNAME 


INTEGER*2 LOC_FNSIZE ' Local file name size 
INTEGER*2 REM-FNSIZE ' Remote file name size 
INTEGER*2 SPOS ! starting token pos. 
INTEGER*2 EPOS ! Ending token pos. 


COMMON /SIZES/ LOC_FNSIZE,REM_FNSIZE,SPOS,EPOS 


Raise lowercase characters to uppercase 


0 1000 1 1,80 
= TCHARCINPC INE (1 I) 
if “ -GE. *61'X .AND. J. ‘Le. *7A'X) THEN 


Get next character 
If its between a and z 


Jo orx make it between A and 7 
one INPLNe 71) = CHAR(J) Replace it in input Line 
CONTINUE 
Get command 
SPOS = 1 ! ptert ing position 
TA GET ! Get next token 

(SP EN) G TO 8000 ! Nothing on Line 


IF 

ib claprind tuhon. EPOSS1) -E0. "GET*) THEN 
GPFLAG = 1 

ELSE If CINPLINE(SPOS:EPOS~1) .£0, ‘PUT') THEN 

ELSE IF (INPLINE(SPOS:EPOS-1) .£0. "HELP') THEN 
CALL HELP 


GO TO 7000 ' Syntax error 
END IF 


Get local filename 


K 
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SPOS = EPOS 

CALL _GET_TOKEN 

IF (SPOS .LT. 0) GO TO 7000 ! Syntax error 
LOC_FNAME = INPLINE(SPOS:EPOS-1) ' Extract filename 
LOC"FNSIZE = EPOS = SPOS i and get size 
Process ‘TO' or ‘FROM’ 

SPOS = ect ts 

CALL GET_TOKEN ' _ next token 


IF (SPOS~.LT. 0) GO TO 4000 mote filename fefaul ted 
IF (GPFLAG .E€Q. 1 AND. INPLINE(SPOS: Epos: oy NE. ‘FROM') 

1 GO 10 6 Syntax error 

IF (GPFLAG .€Q. 3 .AND. INPLINE(SPOS: Epos -1) .NE. ‘TO') 

1 GO TO 7000 ! Syntax error 


Get remote filename 


SPOS = FPos 

CALL _GET_TOKE 

IF (SPOS”.LT. "0 GO TO 7000 
REM_FNAME = NPL INE (SPOS: EPOS-1) 
REM_FNSIZE = EPOS = SPOS 


Get next token 
Syntax error 
Extract filename 
and get size 


Make sure rest of Line is empty 


SPOS = EPOS 
CALL GET_TOKEN 
IF(SPOS [GE. 0) GO TO 7000 ! Syntax error 


If either filename is ‘*', use the other name 


IF (REM_FNAME(1:REM_FNSIZE) .€Q. ‘*') GO TO 4000 
IF (LOCTFNAME(1:LOC"FNSIZE) .NE. **") GO TO 9000 


LOC_FNAME = REM_ FNAME ' Local filename = * 
toc “FNSIZE = REM_FNSIZE 
GO To 9000 


0 
IF (LOC FNAME(1:LOC_FNSIZE) .€Q. ‘*') GO TO 7000 
REM_FNARE = LOC_FNAME ! Remote filename = * 
REM_FNSIZE = LOT_FNSIZE 
GO To 9000 


Syntax error 


WRITE(6,7100) 
FORMAT (1X, *ZDRCOPY-E- SYNTAX, syntax error on command Line‘) 


GPFLAG = 0 


16-SEP-1984 17:09:08.30 Page 9 


DRM 


AOOOAN 


OO 


OO 


M 
DRMASTER.FOR; 1 16-SEP-1984 17:09:06.36 Page 10 DRM 


9000 RETURN 
END 
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| 

SUBROUTINE GET_TOKEN | 
| 

| 

| 


C 

3 This subroutine gets the next token on the input Line. 

C Inputs: : 

3 SPOS = Starting character position 

C Outputs: 

C SPOS = Starting position of token 

: EPOS = One character after end of token 

3 If there are no more tokens on the Line SPOS is set to -1 | 

| 

3 Common variables and areas 
CHARACTER*80 INPLINE ! Input Line | 
CHARACTER*64 LOC_FNAME ' Local file name 
CHARACTER*64 REM_FNAME ! Remote file name 
COMMON /CHARS/ INPLINE,LOC_FNAME ,REM_FNAME | 
INTEGER*2 LOC_FNSIZE ! Local file name size | 
INTEGER*2 REM _FNSIZE !' Remote file name size 
INTEGER*2 SPOS ! Starting token pos. 
INTEGER*2 EPOS ! Ending token pos. | 
COMMON /SIZES/ LOC_FNSIZE,REM_FNSIZE,SPOS,EPOS 

‘ | 

c Return immediately if SPOS is past end of Line 
IF (SPOS .Gt. 80) GO TO 400 | 

C | 

¢ Skip leading blanks | 
DO 100 SPOS = SPOS,80 
IF CINPLINE(SPOS:SPOS) .NE. * *)GO TO 200 

100 CONTINUE | 
GO TO 400 ! No more tokens 

C | 

| SPOS points to start of token. Now find first blank after token 

200 DO 300 EPOS = SPOS,80 
IF CINPLINE(EPOS:EPOS) .£0. * ') GO TO 500 

300 pnt Im 
GO TO 500 

400 SPOS = -1 ! No more tokens 


500 RETURN 
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END 
C 
¢ 
¢ 
¢ 
¢ 
C 
¢ 
¢ 
C 
¢ 
¢ 


on 
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100 
200 


300 
400 


SUBROUTINE HELP 


This subroutine prints out the HELP message 


The commands to DRCOPY are:') 
GET filespec! tow: [counntts * 
PUT filespec! LTO filespec ) 
ORMAT('O',* filespec] is always the local filename'/ 
filespec2 is always the remote filename') 
ORMAT('O', "If either filespec is specified as *, the other ', 
‘filespec is used for both.'/* If the second half of the ', 
‘command is omitted, filespec! is used for filespec2.'/) 


Menon 
2 
= 
a 


RETURN 
END 


DRI 


OO 


OOn 
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SUBROUTINE DO_PUT 


This routine is the top level routine for copying a file 
from the local cpu to the remote cpu. 


INCLUDE "SYSSLIBRARY:XFDEF.FOR/NOLIST' |! DR32 definitions 
INCLUDE ‘*DRCOPY.PRM/NOLIST' ' Parameters 


Local Variables 
INTEGER*®4 STATUS 


Local status 


Common variables and areas 
CHARACTER*80 INPLINE 
CHARACTER*®64 LOC_FNAME Local file name 
CHARACTER*®64 REM_FNAME Remote file name 
COMMON /CHARS/ INPLINE,LOC_FNAME,REM_FNAME 

INTEGER*2 LOC_FNSIZE ' Local file name size 
INTEGER®*2 REM _FNSIZE ' Remote file name size 
INTEGER*2 SPOS : Starting token pos. 
INTEGER*2 EPOS ! Ending token pos. 
COMMON /SIZES/ LOC_FNSIZE,REM_FNSIZE,SPOS,EPOS 

INTEGER®4 XFDATA(30) 

BYTE MBSFRS(BUFSIZ,NUM_MBFRS) 

BYTE SBFRS(BUFSIZ,NUM_SBFRS) 

COMMON /MS_SHARE/ XFDATA,MBFRS,SBFRS 
INTEGER*4 IDEVMSG(32) 


ODE VMSG(32) 
INTEGER*®4 REM _BFRADS(25) 


Input Line 


Context array 
Master buffers 
Slave buffers 


em 


Incoming device messages 
putgetne device messages 
Remote buffer addresses 
File attributes 


INTEGER*4 FILEATIR(G) 


! 

i 

i 

i 
INTEGER*4 CSTATUS ! Common status 
INTEGER*®4 LASTBFRSIZ ' Last buffer size 
INTEGER*4 DDIDIS ' DDI disable 
INTEGER*2 MRMS_CNT ! Master RMS count 
INTEGER*2 MRMS_IDX ' Master RMS index 
INTEGER*2 QPKT_CNT ' Queue packet count 
INTEGER*2 QPKT_IDX ! Queue packet index 
INTEGER® CNT ' Remote buffer count 
INTEGER® ID ! Remote buffer index 
INTEGER*2 NUMREM_BFRS ! Number of remote buffers 
LOGICAL® FLAG ' Get/put flag 
LOGICAL*®1 LASTBFR ' Last buffer flag 
LOGICAL*1 EOFFLAG ! End of file flag 
LOGICAL®1 ERRFLAG ! Error flag 
LOGICAL®1 REMFLAG ! Remote error flag 


C 
C 
C 
C 
C 
C 
C 
C 
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Oona 


OOOON 


GOO 


Ooo 


COMMON /MDATA/ IDEVMSG,ODEVMSG,REM_BFRADS, FILEATIR, CSTA 
1 LASTBFRSIZ,DDIDIS,MRMS_CNT.MRMS_IDX,QPKT_CNT, 
é bPKT 1DX,REM_CNT,REM 15x NUMREM~BFRS,GPFCAG, 


CHARACTER*64 OFNA 
BYTE ODEVMSGB(128) 


EQUIVALENCE SOP Aatinein cits 
EQUIVALENCE (OFNA,ODEVMSGB(33)) 


INTEGER*4 SYSSCLREF 
INTEGER®4 SYSSWAITFR 


Initialize flags 


LASTBFR = .FALSE. ' Last buffer flag 
EOFFLAG = .FALSE. ! End of file flag 
ERRFLAG = a0 fe ' Error flag 

REMFLAG = .FALSE. ! Remote error flag 


Queue a NOP packet to the DR32. The purpose of this 
is to examine the DDI disable bit in the DSL to determine 
if the DR32 at the other end is ready to go. 


CALL QUEUE_NOP(STATUS) 
IF (.NOT. STATUS) RETURN 


Open local file and copy file attributes into device 
message array. 
cau OPEN NEEL CL OC FNAME ,LOC_FNSIZE,ODEVMSG(3) ,STATUS) 


TUS) 
CALL " ERROR (STATUS. «FALSE. ) 
RETURN 


Finish building device message and send it. 


ODEVMSG(1) = : Packet type 

oe heat AT = BUFSIZ Buffer size . 
ODE VM cat32) = UREN. FNSIZE Remote filename size 
OFHA’s a FNAM ' Remote filename 


' 
i 
i 
i 
STATUS = STSSCLREF (RVAL(1)) ' Clear event flag 
IF (.NO’. STATUS) 7 te FATAL _ERROR (STATUS) 
CALL XFSCKTBLD (XFDA TA, ; 

i 

i 

i 


1 XF$K_PKT_WRTCM, 
: OOEVMSG, 
4 %, 


Context array 

Function = srite ctrl msg 
No index or size 

Device message 

! Device message size 


oe 


F 
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Oona 


COOOL 


8000 


' No log area 
64+256, i Ins. @ head, int. if Q empty 
i No action routine or parm 
§fatus) i Status 
(.NOT. STATUS) ah Rahs ~ERROR (STATUS) 


(.NOT. STATUS) CALL ATA ERROR (STATUS) 

(.NOT. CSTATUS) THEN ! Error from remote system 
CALL ERROR(CSTATUS ,REMFLAG) 

GO TO 8000 


Wait for event flag 


Ne OCONO UT 


Set up buffer counters and indexes 


MRMS_CNT = NUM_MBFRS = 1 ' # of avl RMS buffers 
MRMS_IDX = 2 ' Next RMS buffer 

QPKT_CNT = 0 ! # of buffers to be queued 
QPKT_IDX = 1 ! Next buffer to be queued 
REM_CNT = NUMREM_BFRS ! # of remote buffers 
REM_IDX = 1 ! Next remote buffer to use 


Start the transfer going by starting an RMS read and then . 
wait until it completes. 


STATUS = SYSSCLREF (ZVAL(3)) ! Clear event flag 
IF (.NOT. STATUS) CALL FATAL ERROR(STATUS) 

CALL START RMS(MBFRS(1,1) BUFSIZ,GPFLAG)! Start RMS 
STATUS = SYSSWAITFR(ZVAL( (45) i Wait for event flag 
IF (.NOT. STATUS) CALL FATAL ERROR(STA Tug)” 

IF (.NOT. CSTATUS) CALL ERROR(CSTATUS,REMFLAG) 


CALL CLOSE FILE(STATUS) 
IF (.NOT. STATUS) CALL ERROR(STATUS,.FALSE.) 


DRI 


DRMASTER.FOR; 1 


SUBROUTINE DO_GET 


from the remote cpu to the local cpu. 


INCLUDE *SYSSLIBRARY:XFDEF, ;FOR/NOLIST® 
INCLUDE ‘DRCOPY.PRM/NOLIST* 


Local Variables 
INTEGER®4 STATUS 


Common variables and areas 


CHARACTER*80 INPLINE 
CHARACTER*64 LOC_FNAME 
CHARACTER*64 REM_FNAME 


INTEGER*2 LOC_FNSIZE 
eb 3 da REM" FNSIZE 
INTEGER*2 SPOS 
INTEGER*2 EPOS 


INTEGER*4 hep iy et 

BYTE MBFRS(BUFSIZ,NUM_MBFRS) 

BYTE SBFRS(BUFSIZ,NUM_SBFRS) 

COMMON /MS_SHARE/ XFDATA,MBFRS,SBFRS 


INTEGER*4 IDEVMSG(32) 
INTEGER*4 ODEVMSG(32) 


LOGICAL*®1 REMFLAG 


This routine is the top level routine for 
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copying a file 


! DR32 definitions 


! Parameters 


Local status 


Input Line 
Local file name 
Remote file name 


COMMON /CHARS/ INPLINE,LOC_FNAME ,REM_FNAME 


! Local file name size 
Remote file name size 
i Starting token pos. 

! Ending token pos. 


COMMON /SIZES/ LOC_FNSIZE,REM_FNSIZE,SPOS,EPOS 


Context array 
Master buffers 
Slave buffers 


Incoming device messages 
guteerns device messages 
Remote buffer addresses 
File attributes 

Common status 

Last buffer size 

DDI disable 

Master RMS count 

Master RMS index 

Queue packet count 

Queue packet index 
Remote buffer count 
Remote buffer index 
Number of remote buffers 
Get/put flag 

Last buffer flag 

End of file flag 

Error flag 

Remote error flag 


DRI 


AON 


QOOnN 


COON 


H 
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COMMON /MDATA/ IDEVMSG ODEVMSG REM Be rans. FILEATTR, CSTATUS 

1 LASTBER RS17 DIDis»m S_CNT “MRMS _1DX GPkT_cNf, 

: 1DX x REM pen 15X ,NUMREM~BFRS,GPFCAG, 
CASTBER. EOFFCAG ERRFLAG. REMFLAG™ 


CHARACTER*64 OFNA 
BYTE ODEVMSGB(128) 


EQUIVALENCE aggre Boyd i 
EQUIVALENCE (OFNA,ODEVMSGB( 


INTEGER*4 SYSSCLREF 


INTEGER*4 SYSSWAITFR 
INTEGER®4 SYSSWFLAND 


Initialize flags 


Oona 


LASTBFR = .FALSE. ' Last buffer flag 
EOFFLAG = .FALSE. ' End of file flag 
ERRFLAG = .FALSE. ' Error flag 
REMFLAG = .FALSE. ! Remote error flag 


Queue a NOP packet to the DR32. The prsece of this is to 
examine the DDI disable bit in the DSL to determine if 
the DR32 at the other end is ready to go. 


CALL QUEUE_NOP(STATUS) 
IF (.NOT. STATUS) RETURN 


SOAOOLNM 


Build a message to send to the remote system indicating we 
want to GET a file. Send the remote filename. 


OOOL 


ODEVMSG(1) = 3 ! Message type 
ODEVMSG(2) = BUFSIZ ' Buffer size 

ODE V: MSGB (32) = ae ree ! Remote filename size 
OFNA = REM_FNAME ! Remote filename 


Send the message and wait for 2 packets in response: 
1) the file attributes and 2) the remote buffer addresses. 


STATUS = SYSSCL BEF CEVAL C1) 

IF (.NOT. STATUS) CALL AH ERROR (STATUS) 
STATUS = SYSSCLREF (ZVAL 

IF (.NOT. STATUS) CALL FATAL ERROR(STATUS) 


OOOH 


CALL XFSPKTBLD(XFDATA, ' Context array 

1 XFSK_PKT_WRTCM,,, ! Function, no index or size 

4 ODEVASG,92., i Device msg, size, no log area 
64+ " ape i Ins. @ head, int. if Q Q empty 


DRI 


OOOO 


VMOOOOOOOMN 


OOOH 


OOon 


OO 
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& STATUS) ! Status 
IF (.NOT. STATUS) CALL FATAL_ERROR(STATUS) 
STATUS = SYSSWFLAND(ZVAL(1),%VAL(6)) ! Wait for both responses 
IF (.NOT. STATUS) CALL FATAL_ERROR(STATUS) 
IF (.NOT. CSTATUS) THEN 

CALL ERROR(CSTATUS,REMFLAG) 

RETURN 
END IF 
Create the local file using the file attributes sent by 
the remote system. 
CALL CREATE _FILE(LOC_FNAME,LOC_FNSIZE,FILEATTR,STATUS) 
IF (.NOT. STATUS) THEN 

CALL RMS_ERROR(STATUS) 

CALL ERROR(STATUS,.FALSE.) 

RETURN 
END IF 
Set up buffer counters and indexes 
MRMS_CNT = -1 ! RMS is not going 
MRMS_IDX = 1 ! Next RMS buffer 
QPKT_CNT = NUM_MBFRS ! # of buffers to be queued 
QPKT_IDX = 1 ' Next buffer to be queued 
EM_CUNT = 0 ! # of remote buffers 
REM_IDX = 1 ! Next remote buffer 
Start the transfer going and wait until it completes. 
STATUS = SYSSCLREF(ZVAL(3)) 
IF (.NOT. STATUS) CALL FATAL_ERROR(STATUS) 
ODEVMSG(1) = 11 ' Start remote sys. going 
CALL XFSPKTBLD(XFDATA, ' Context array 
1 XFSK_PKT_WRICM,,, ! Function, no index or size 
§ ODEVASG,4., ! Device msg, size, no log area 

64+256,.. ! Ins. @ head, int. if Q@ empty 


& STATUS 
IF (.NOT. STATUS) CALL FATAL_ERROR(STATUS) 


STATUS = SYSSWAITFR(ZVAL(3)) 
IF (.NOT. STATUS) CALL FATAL_ERROR(STATUS) 
IF (.NOT. CSTATUS) CALL ERROR(CSTATUS ,REMFLAG) 


CALL CLOSE _FILE(STATUS) 
IF _(.NOT. STATUS) CALL ERROR(STATUS,.FALSE.) 
ae 


DRI 


AQAMOOON 


OO 


OO 
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POOOOMAOAOAOOOOLS 


OOn 


COOL 
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SUBROUTINE QUEUE_NOP(DSTATUS) 


This routine queues a NOP packet to the DR32 to determine 
if the remote cpu is ready to start a transfer. This is 

accomplished by testing the DDI disable bit in the DSL 

in the packet. The actual testing of the bit is done at 

AST Level by an action routine and the result is returned 
in the variable DDIDIS. 


DSTATUS is returned as follows: 


0 Remote CPU not ready (this routine prints 
error message) 
1 Remote CPU ready (success) 


INCLUDE ‘SYSSLIBRARY:XFDEF.FOR/NOLIST’ ! DR32 definitions 
INCLUDE ‘DRCOPY.PRM/NOLIST' ' Parameters 


Local Variables 
INTEGER*4 STATUS 


Local status 


Common variables and areas 
INTEGER®4 XFDATA(30) 

BYTE MBFRS(BUFSIZ,NUM_MBFRS) 
BYTE SBFRS(BUFSIZ,NUM_SBFRS) 


COMMON /MS_SHARE/ XFDATA,MBFRS,SBFRS 


Context array 
Master buffers 
Slave buffers 


INTEGER®4 jeewse tes? ! Incoming device messages 
INTEGER*4 ODEVMSG(32) : puteetng device messages 
INTEGER*4 REM _BFRADS(25) ! Remote buffer addresses 
INTEGER®4 FILEATTR(6) ' File attributes 
INTEGER®*4 CSTATUS ' Common status 

INTEGER*4 LASTBFRSIZ ' Last buffer size 
INTEGER*4 DDIDIS ! DDI disable 

INTEGER®2 MRMS_CNT ' Master RMS count 
INTEGER*2 MRMS_IDX ' Master RMS index 
INTEGER*2 QPKT_CNT ' Queue packet count 
INTEGER*®2 QPKT IDX ' Queue packet index 
INTEGER*2 REM_CNT ' Remote buffer count 
INTEGER*2 REM IDX ! Remote buffer index 
INTEGER*2 NUMREM_BFRS ' Number of remote buffers 
OGICAL*1 GPFLAG ! Get/put flag 

LOGICAL*1 LASTBFR ' Last buffer flag 
LOGICAL*®1 EOFFLAG ! End of file flag 
LOGICAL*1 ERRFLAG ' Error flag 

LOGICAL®1 REMFLAG ! Remote error flag 

COMMON /MDATA/ IDEVMSG,ODEVMSG,REM_BFRADS,FILEATTR,CSTATUS 

1 LASTBFRSIZ,DDIDIS.MRMS_CNT.MRMS_IDX.QPKT_CNT, 
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REM_CNT,REM_IDX,NUMREM_BFRS,GPFLAG, 
é CASTBER REO FFCAG,ERRFCAG,REMFLAG™ 
INTEGER*4 DSTATUS 


INTEGER*4 SYSSCLREF 
INTEGER*4 SYSSWAITFR 


EXTERNAL ACT_NOPPKT 


STATUS = ST SSCL Orr ceval. 61)? ! Clear event flag | 
IF (.NOT. STATUS) CALL FATAL_ERROR(STATUS) 
CALL XFSPKTBLD(XFDA TA ' Context ss 
1 XF SK PRT _NOP, ' Function = NOP 
2 i No we ys size, dev. msg, Log area 
3 ui: 356, i Ins. @ head, int. if Q empty 
4 ACT NOPPKT,, Action routine, parm. 
5 STATUS) Status 
IF (.NOT. STATUS) CALL 445; LERROR( STATUS) 
STATUS = SYSSWAITFR(ZVAL(1) Wait for completion 
IF (.NOT. STATUS) CALL TAL _ERROR( STATUS)” 
| 


routine ACT_NOPPKT. If non-zero, then print an error message. 


IF (DDIDIS .NE. 0) THEN 
WRITE (6, 100) 
100 FORMAT (fx, greets remote DR32 not ready’) 


C 
: Test DDIDIS which was set at AST level by the action 
C 


DSTATUS = ' Success 
D IF 


RETURN 
END 


DRMASTER.FOR; 1 


SUBROUTINE MRMS_AST (RAB) 
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C 
C This subroutine is the Master RMS completion routine. It 
C is called at AST level to start ~e next RMS operation 
C and to queue a packet to the DR32 to read or write the next 
C buffer. 
C 
INCLUDE o aiane” pee! ' Parameters 
PARAMETER RABSK 44'X 
PARAMETER RABSW_ oR = ty” 
PARAMETER RABSL-STS = *x 
PARAMETER RMS$_EOF = '1827A'X 
C 
: Local Variables 
INTEGER*4 STATUS ' Local status 
INTEGER*4 RAB(RABSK_BLN/4+1) 
INTEGER®*®4 SIZ 
INTEGER*®4 BFRSIZE 
C 
; Common variables and areas 


INTEGER*4 XFDATA(30) 

BYTE MBFRS(BUFSIZ,NUM_MBFRS) 

BYTE SBFRS(BUFSIZ,NUM_SBFRS) 

COMMON /MS_SHARE/ XFDATA,MBFRS,SBFRS 


INTEGER*4 pee nsete ) 


LOGICAL*1 REMFLAG 
prs /MDATA/ LASTBFREIZ DDID 


é OPKT héR T,REM_I 


CASTBRR. “EOF FLAG. enarcae R 


REM_BFRADS.,. 
fs RMS CNT MRMS IDX.OPKT CNT, 
NUARER “BFRS,GPFCAG, 


Context array 
Master buffers 
Slave buffers 


Incoming device messages 
pees device messages 
Remote ul rer addresses 
File attributes 

Common status 

Last buffer size 

DDI disable 

Master RMS count 

Master RMS index 

Queue packet count 

Queue packet index 
Remote buffer count 
Remote buffer index 
Number of remote buffers 
Get/put flag 

Last buffer flag 

End of file flag 

Error fla 

R mote error flag 


ILEATTR,CSTATUS 


DRI 


OOK 


COO 


QO 


OOO 


OOOO 


WVMOOOOOOOO 


M 
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INTEGER®4 SYSSSETEF 
EXTERNAL SS$_NORMAL 


If ERRFLAG is set, then set event flag 3 to wake up main level 
and return. 


IF (ERRFLAG) THEN 
TATUS = SYSSSETEF (ZVAL(3)) 
-NOT. STATUS) CALL FATAL_ERROR(STATUS) 


Check for success or failure of last operation. If success 
see if an entire buffer was transferred. If not, set the 

end of file flag. If error is RMS$_EOF and doing a Put, then 
also set end of file flag. 


STATUS = yw psy $TS/4+1) de +p from RAB 
IF (STATUS) GO TO 400 
IF (STATUS .EQ. RMS$_EOF .AND. GPFLAG £0, “35° 60 TO 450 


CALL RMS ERROR (STATUS) 
RETURN 
1F (GPFLAG .EQ. 1) GO TO 500 ! Only check EOF for PUT 
BFRSIZE = RAB(RABSW RS1/4+1)/65536 i Get size of buffer 
IF (BFRSIZE .NE. BUFSI 
EOFFLAG = .TRUE. ! Set end of file flag 
LASTBFRSIZ = BFRSIZE 
0 TO 700 


Decrement the count of the number of buffers available 

for an RMS operation. If the count gees negative, then 

we ran out of buffers temporarily and can't start an RMS 
operation (the next RMS operation will get started in the 
ACT_RWPKT routine which makes buffers available for RMS 

hy Otherwise, start the next RMS operation now. 


MRMS at = MRMS_CNT - 1 ' Decr. RMS buffer count 
IF (ARMS_CNT .GE. 0) THEN 
Sirens = BU FSI2 ! Assume not last buffer 
IF (LASTBFR .AND. MRMS_CNT .EQ. 0) 
1 SIZE = LASTBFRSIZ This is the last buffer ; 
CALL START “ARS (HBF RSC MRMS_IDX), size, OPFLAG) ! Start RMS operation 
MRMS_IDX ="MRMS_IDX + : Advance next buffer index 


_ if (ARMS_IDX .GT. NUM_MBFRS) MRMS_ IDX = 1 ! modulo NUM MBFRS 
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If MRMS_CNT is less than 0 and LASTBFR is .TRUE. then we 
are finTshed doing a GET. Wake up main Level. 


If (MRMS_CNT aN: 0 tg as teree THEN 

CSTATUS LOC(SS$ ! Indicate success 
coitus: = “S¥§ SETEF PrRVAL th) i Wake up main Level 
— if (.NOT. STATUS) CALL FATAL LERROR (STATUS) 


Increment the number of buffers available to be queued to the 
DR32. If we have a_matching remote buffer then queue an 
operation to the DR32. 


QPKT_CNT = QPKT_CNT + 1 ! Incr. QPKT buffer count 
IF (REM_CNT .GT> 0) CALL QUEUE_PKT 


RETURN 
END 


DRI 


DRMASTER.FOR; 1 


SUBROUTINE QUEUE_PKT 


INCLUDE ‘DRCOPY.PRM/NOLIST' 


Local Variables 
INTEGER*®4 é Func 


SIZE 
INTEGER®2 BFRCNT 
Common variables and areas 


INTEGER®4 XFDATA(30) 
BYTE MBFRS(BUFSIZ,NUM_MBFRS) 
BYTE SBFRS(BUFSIZ,NUM_SBFRS) 


INTEGER®4 JOE Vnse Se? 
VMSG(32) 


LOGICAL*®1 REMFLAG 


é bPRT TerRsiZ Ol 


EXTERNAL ACT_RWPKT 


Decrement buffer counters 


This routine queues read or write data 
It is called from either MRMS_AST, MFQ 
only when both a local and a remote buffer are available. 


INCLUDE ‘SYSSLIBRARY:XFDEF, ;FOR/NOLIST' 


“yee: /MDATA/ iene etyts 
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COMMON /MS_SHARE/ XFDATA,MBFRS,SBFRS 


ee te ee ee ee ee ee ee 


ackets to the DR32. 
NXTBFR, or MFQ_PLSTBFR 


DR32 definitions 


' Parameters 


Context array 
Master buffers 
Slave buffers 


Incoming device messages 
ae iy device messages 
Remote buffer addresses 
File attributes 

Common status 

Last buffer size 

DDI disable 

Master RMS count 

Master RMS index 

Queue packet count 

Queue packet index 
Remote buffer count 
Remote buffer index 
Number of remote buffers 
Get/put flag 

Last buffer flag 

End of file flag 

Error flag 

Remote error flag 


REM hy: 4 § Arie Ton. CSTATUS 
DIS,M py 


CASTBFR. EOFFLAG. ERRFCAG. AiGmen 


mRRS IDX. QPKT CNT, 
M~BFRS,GPFCAG, 


OM AMOOn 


CON 


10¢ 


DRMASTER.FOR; 1 


C 
REM_CNT = REM CNT = 1 
QPKT_CNT = QPRT_CNT = 1 


Queue packet to DR32. 


ODEVMSG(1) = REM PY ee IDX) 
IF ad LA G Fe. T)_THEN 
FUNC = XFSK_PKT_RD 
BFRCNT : RER CNT 


FUNC = KFSK_ PKT WRT 
> — = QPRT_CRT 


Oona 


IF (BFRCNT.EQ.0 .AND. EOFFLAG) THEN 
ELS SIZE = LASTBFRSIZ 


E 
SIZE =BUFSIZ 


END IF 
CALL KF SPRTBLD(XFDATA, 

2 QPKT IDX, 

3 SIZE; 

4 ODEVMSG, 

5 4, 

é 

7 34466, 

& ACT_RWPKT,, 
9 STATUS) 


Adjust buffer indexes 


REM_IDX = REM_IDX 
IF TREN, IDX, AS NUMRER. BFRS) REM_IDX=1 
IF (OPKT iox. GT. NUM_MBFRS) QPKT_IDX=1 


OOo 


Check for success from XFSPKTBLD 


OOO 


RETURN 
END 


ee ee er ee ee te ee 


IF (.NOT. STATUS) CALL FATAL_ERROR(STATUS) 
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' Remote buffer count 


QPKT buffer count 


Device msg is remote bfr. addr. 


Doing a GET 


Doing a PUT 


This is the last buffer 
Not the Last buffer 


Context array 

Function 

Buffer index 

Size of transfer 

Device message 

Size of device message 
No log area 

Send all, int. on Q empty 
Action routine, no param. 
Status 


Advance remote buffer index 
modulo # of remote buffers 
Advance QPKT buffer index 
modulo # of local buffers 


DRMASTER.FOR; 1 


FOOOOOON 


OOO 


SUBROUTINE PKT_AST 


This routine is called whenever a DR32 command packet is 
pieced on an empty termination queue. This routine calls 
FSGETPKT which removes the packet at the head of the 
termination queue and calls the action routine, if there is 
one. This routine must process all packets on the 
termination queve until the queue is empty. 


INCLUDE ‘DRCOPY.PRM/NOLIST' ! Parameters 
PARAMETER SHRS_QEMPTY = '1280'X 


Local Variables 
INTEGER*®4 STATUS 


Common variables and areas 


INTEGER®4 XFDATA(30) ' Context array 

BYTE MBFRS(BUFSIZ,NUM_MBFRS) ! Master buffers 

BYTE SBFRS(BUFSIZ,NUM_SBFRS) ! Slave buffers 

COMMON /MS_SHARE/ XFDATA,MBFRS,SBFRS 

CALL XFSGETPKT(XFDATA,1,,.,,.STATUS) Calls action routine 


IF (STATUS) GO 


TO ! Repeat until q empty 
IF (STATUS .EQ. SHR$_QEMPTY) GO TO 9000 


Have a fatal error - print error and I0SB 

CALL DR32_ERROR ! Doesn't return 
RETURN 

END 


Dd 
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SUBROUTINE ACT_NOPPKT 


C 
C This routine is the action routine for NOP packets. It 
; tests the DDI disable bit in the DSL and sets DDIDIS. 
INCLUDE ‘SYSSLIBRARY:XFDEF.FOR/NOLIST’ ! DR32 definitions 
INCLUDE ‘DRCOPY.PRM/NOLIST' ' Parameters 
‘ | 
§ Local Variables 
INTEGER*®4 STATUS 
c | 
: Common variables and areas 


INTEGER®4 XFDATA(30) 

BYTE MBFRS(BUFSIZ,NUM_MBFRS) 

BYTE SBFRS(BUFSIZ,NUM_SBFRS) 

COMMON /MS_SHARE/ XFDATA,MBFRS,SBFRS 


INTEGER*®4 IDEVMSG(32) 


Context array 
Master buffers 
Slave buffers 


' Incoming device messages 
: putoetny device messages 
u 


' Last buffer flag 

! End of file flag 
' Error flag 

LOGICAL*1 REMFLAG ! Remote error flag 


COMMON /MDATA/ IDEVMSG,ODEVMSG,REM_BFRADS,FILEATTR,CSTATUS 

1 LASTBFRS1Z,DDIDIS,MRMS_CNT.MRMS_IDX,QPKT CNT, 

é QPKT_IDX,REM_CNT,REM_IDX,NUMREM~BFRS,GPFCAG, 
LASTBFR,EOFFCAG,ERRFCAG,REMFLAG 

INTEGER®4 SYSSSETEF 

INTEGER®*4 DSL ! DR32 status longword 


EQUIVALENCE (DSL,XFDATA(8)) 


i 

' 
INTEGER*®4 REM_BFRADS(25) ! Remote buffer addresses 
INTEGER*®4 FILEATTR ' File attributes 
INTEGER*®4 CSTATU ! Common status 
INTEGER*®4 LASTBFRSIZ ' Last buffer size 
INTEGER*4 DDID ! DDI disable 
INTEGER®*2 MRMS_CNT ! Master RMS count 
INTEGER®2 MRMS_IDX ' Master RMS index 
INTEGER*2 QPKT_CNT ' Queue packet count 
INTEGER*2 QPKT_IDX ' Queue packet index 
INTEGER*2 REM_CNT ! Remote buffer count 
INTEGER*2 REM I ! Remote buffer index 
INTEGER®*2 NUMREM_BFRS ' Number of remote buffers 
LOGICAL*1 GPFLA Get/put flag 

! 

' 

t 


OR 


VuUYVYV YUWY YVYUY wuw 
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ALL FATAL_ERROR(STATUS) 


XFSM_PKT_DDIDIS 


RVALT1)) 
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DRMASTER.FOR; 1 
SUBROUTINE ACT_RWPKT 


This subroutine is the action routine for 
data packet which has just completed. 


OOO 


INCLUDE ‘SYSSLIBRARY: hid ;FOR/NOLIST' | 
INCLUDE "DRCOPY.PRM/NOLIST 


Local Variables 


INTEGER*4 STATUS 
INTEGER*®4 SIZE 


OOo 


Common variables and areas 

INTEGER®4 XFDATA(30) 

BYTE MBFRS(BUFSIZ,NUM_MBFRS) 

BYTE SBFRS(BUFSIZ,NUM_SBFRS) 

COMMON /MS_SHARE/ XFDATA,MBFRS,SBFRS 


INTEGER*®4 IDEVMSG(32) 


OOo 


~ 

2 

= 

m 

a 

m 

» 

= 
DwDoo 
ON EB 
BZBxxzsze~ 

~ 

o 

z 

— 


LOGICAL®1 REMFLAG 

COMMON /MDATA/ IDEVMSG ODE VMSG 
1 LASTBFRS1Z,DDIDIS 
é OPKT IDX ep? iNT REM 
INTEGER*4 DSL ! 


EQUIVALENCE (DSL,XFDATA(8)) 
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a Read or Write 


DR32 definitions 


' Parameters 


Context array 
Master buffers 
Slave buffers 


! Incoming device messages 
: putgetne device messages 
' Remote bu 

' File attributes 

' Common status 

' Last buffer size 

' DDI disable 

' Master RMS count 

' Master RMS index 

' Queue packet count 

' Queue packet index 

' Remote buffer count 

' Remote buffer index 

' Number of remote buffers 
} ey flag 


ffer addresses 


Last buffer flag 


i End of file flag 
' Error flag 
! Remote error flag 


REM_BFRADS, FILEATIR, CsTATus 
“we ‘ CNT REM ~BFRE. GPrCAG 
LASTBFR, EOF FLAG. eneneAb REMFLAG ? 


T_CNt, 


e 


DR32 status longword 


DR 


FOOOOON 


WMOOOOOOOLS 


S 


H 
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If (.NOT. DSL) CALL DR32_ERROR ! Error in DSL 


Send a message to the remote system telling it that it's 
next buffer has been processed (filled or emptied). 

the size of the transfer is not equal to the buffer size, 
then it must have been the last transfer. 


IF (XFDATA(4) .NE. BUFSIZ) THEN 
MODE = 64 Last transfer - insert at tail of Q 


ODEVMSG(1) = Last buffer message 
ODEVMSG(2) = LASTBFRSIZ Send size 
LASTBFR = .TRUE. Set fla 


Not last transfer 
Insert at head of Q 
Next buffer message 


MODE = 64 + 256 
> eat = 5 


IF (LASTBFR .AND. GPFLAG .EQ. 1) GO TO 5000 ! Don't send if last buffer and GET 


CALL XFSPKTBLD(XFDATA, 
1 XFSK_PKT_WRTCM,,, 
DEVASG,8,, 


! Context array 7 
' Function, no index or size 
! Device msg, size, no log area 
' Mode, no action routine 
5, seeree 


wn 


rs STATUSS 
IF (.NOT. STATUS) CALL FATAL_ERROR(STATU 


Increment the count of the number of buffers available for 
an RMS operation. If the count equals zero, then we 
previously ran out of RMS buffers and therefore there is 

no RMS operation in progress. In this case, we start the 
next RMS operation. If the count is greater than zero, then 
there is already an RMS operation in progress. 


MRMS_ CNT = MRMS_CNT + 1 


IF (ARMS_CNT .€0. 0) THEN 
SIZE = BUFSIZ ' Assume not Last buffer 
IF (LASTBFR) SIZE = LASTBFRSIZ i This is the Last buffer (GET only) 
CALL START_RMS(MBFRS(1,MRMS_IDX),SIZE,GPFLAG) ! Start RMS 
MRMS_IDX ="MRMS IDX + { "Advance RMS buffer index 
7 LF (ARMS_IDX .GT. NUM_MBFRS) MRMS_IDX = 1 ! modulo NUM_MBFRS 


! Incr. RMS buffer count 


RETURN 
END 
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SUBROUTINE ACT_FREQUE 


This routine is the action routine for packets that were 

on the free queve. First it puts another packet on the free queue, 
and then calls the appropriate routine based on the type code 

in the device message. 


AOOOOON 


INCLUDE "DRCOPY.PRM/NOLIST' 
PARAMETER SHRS$_VALERR = ‘11E8'X 


Parameters 


Local Variables 
INTEGER*®4 STATUS 


oon 


Common variables and areas 
INTEGER®4 IDEVMSG(32) 


OOO 


! Incoming device messages 


' Last buffer flag 
! End of file flag 
' Error flag 

LOGICAL*®1 REMFLAG ! Remote error flag 


COMMON /MDATA/ IDEVESG ODE VMsG REM BFRADS, FILEATIR, CSTATUS 
! STBERSIZ hém iets Renn aps M~BFRS, par nt, 
7 GPK 1D. jRER cut REM 1X “anne ; 


1 
INTEGER*4 ODEVM : putgoing os device messages 
INTEGER*4 REM _BFRADS(25) ! Remote buffer addresses 
INTEGER*®4 PILEATT ' File attributes 
INTEGER®4 CSTA ' Common status 
INTEGER*®4 LASTBFRSIZ ' Last buffer size 
INTEGER*4 DDID ' DDI disable 
INTEGER*2 MRMS_CNT ! Master RMS count 
INTEGER*2 MRMS_IDX ' Master RMS index 
INTEGER*2 QPKT_CNT ! Queue packet count 
INTEGER*2 QPKT_IDX ' Queue packet index 
INTEGER*2 REM_CNT ! Remote buffer count 
INTEGER*2 REM | ' Remote buffer index 
INTEGER*2 NUMREM_BFRS ' Number of remote buffers 
LOGICAL®1 GPFLAG Get/put flag 

' 

' 

' 


CALL FREESET ! Put another packet on FREQ 
GO TO (100,200,300,400,500,600,700,800,900,1000,1100) , IDEVMSG(1) 


Invalid packet 
CALL FATAL_ERROR(SHR$_VALERR) 


OO 


DR 


QO 


COON 


COON 


DRMASTER.FOR; 1 


SOOO Aon VOOM SOOO WNOO NOOO ROO 
S S S S S S 


s 


WAan 
S 


ls 


aon 


Type code = 1 Start a PUT M-=> 5S 
At Ot sha TARTPUT (CIDEVMSG) 
Type code = 2 Slave buffer addresses Ss -=> 
EAL MFQ_BiRADS 
0 9000 
Type code = 3 Start a GET M=> 5S 
CALL SFQ_STARTGETC(CIDEVMSG) 
GO TO 9000 
Type code = 4 File attributes S$ =>. 
CALL MFQ_FILEATTR 
GO TO 9000 
Type code = 5 Processed next buffer M-=> 5S 
CALL SFQ_PNXTBFRCIDEVMSG) 
GO TO 9000 
Type code = 6 Processed next buffer S$ ->> 
CALL MFQ_PNXTBFR 
GO TO 9000 
Type code = 7 Processed last buffer M=-> 5S 
CALL SFQ_PLSTBFR(IDEVMSG) 
GO TO 9000 


Type code = 8 Processed last buffer S->> MM 
CALL MFQ PLSTBFR 

GO TO 9000 

Type code = 9 Error M-=> 5S 

CALL SLV_SHUTDOWN 

GO TO 9000 


Type code = 10 Error S$ => 
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DR 
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C 
1000 CALL MFQ — 
GO 70 900 


Type code = 11 Start sending data (Get only) M-=>5§ 
100 CALL SFQ_GOGET 


| 


DRMASTER.FOR; 1 


OOK 


OOO 


OOo 
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SUBROUTINE FREESET 


This routine puts an empty packet on the FREQ. It is calle 
ACT_FREQUE and the only reason it's a subroutine is that AC 


df 
TF 
can’t be an external in ACT_FREQUE. = 


rom 
REQUE 
INCLUDE "DRCOPY.PRM/NOLIST' 


Local variables 
INTEGER®4 STATUS 


Common variables and areas 


INTEGER®4 XFDATA(30) ' Context array 
BYTE MBFRS(BUFSIZ,NUM_MBFRS) ' Master buffers 
BYTE SBFRS(BUFSIZ,NUM_SBFRS) ' Slave buffers 


COMMON /MS_SHARE/ XFDATA,MBFRS,SBFRS 
EXTERNAL ACT_FREQUE 
ee pahachbeentaniis shycchicne 


2 Se 

3 ACT_FREQUE,, Action routine and parameter 
4 STATUS) ! Status 
IF (.NOT. STATUS) CALL FATAL_ERROR(STATUS) 


RETURN 
END 


!' Number of packets 
AST if TERMQ empty 
i 


DRI 


OOM 


DRMASTER.FOR; 1 


OOO OOOn 


OOn 


100 


SUBROUTINE MFQ_BFRADS 


This routine is called to process the list of buffer 
addresses sent over by the slave. 


Local Variables 
INTEGER*®4 STATUS 


Common variables and areas 
INTEGER#®4 [ee vare tes? 
INTEGER#®4 ac ee 


’ incon ine device messages 
' Outgoi ng device messages 
! Remote buffer addresses 


INTEGER®4 FILEATTR ' File attributes 
INTEGER*4 C ' Common status 
INTEGER®4 LASTBFRSIZ ' Last buffer size 
INTEGER*®4 D ! DDI disable 
INTEGER®*2 MRMS_CNT ! Master RMS count 
INTEGER*2 MRMS_ IDX ! Master RMS index 

os ! Queue packet count 
INTEGER®2 QPKT_IDX ' Queue packet index 
INTEGER*2 REM_CUN ! Remote buffer count 
INTEGER*2 RE x ' Remote buffer index 

' Number of remote buffers 


! Get/put flag 

' Last buffer flag 
! End of file flag 
' Error flag 
LOGICAL*1 REMFLAG ! Remote error flag 


ie /MDATA/ LASTOPRSIZ DDIDIS, »REM_BFRADS, A he carats 


RRS C CNT. T CNT, 
é QPKT IDX ate “BFR ngs cPrcac. 
LASTBFR, ECF FCA. ghEM 1X RCMFCAG™ 


INTEGER®4 SYSSSETEF 
EXTERNAL SS$_NORMAL 


— 

z 

ts 

m 

a 

m 

z 

& 
DDoo 
mvvU Shu 
BZzBzxxzszew-r 

+nuno 

oO 

z 

~ 


NUMREM BFRS NUMREROPRS ' Number of remote buffers 


REM_CNT = 
DO 100 I = 1,NUMREM 
REM_BFRADS (15 2 IDEDHSGC1+2) ! Store each address 


CSTATUS = ZLOC(SS$ es :. 
STATUS = SYSSSETEFTZVAL 
IF (.NOT. STATUS 


RETURN 


' Set event flag 
) CALL FATAL _ERROR (STATUS) 


M 
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Tee eee eee eee eee eee 2 egies Ga: <a “a: | arn Sigh pet a 
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DRMASTER.FOR; 1 16-SEP-1984 17:09:08.30 Page 38 


OOM AMOONO 


OO 


100 


SUBROUTINE MFQ_FILEATTR 


This routine copies the file attributes sent by the remote 
system (at the start of a GET) from the input device message array 
to the file attributes array and then sets an event flag. 


Local Variables 
INTEGER*4 STATUS 


Common variables and areas 


INTEGER®4 IDEVMSG(32) 
INTEGER®4 ODEVMSG(32) 
INTEGER®4 REM_BFRADS(25) 
INTEGER®4 PILEATIR(G) 


! Incoming device messages 
' Outgoing device messages 
' Remote buffer addresses 
! File attributes 


' Last buffer flag 
! End of file flag 
' Error flag 

! Remote error flag 


LOGICAL*1 REMFLAG 

COMMON /MDATA/ IDEVMSG,ODEVMSG,REM_BFRADS,FILEATTR,CSTATUS 

1 LASTBFRSIZ,DDIDIS,MRMS_CNT.MRMS_IDX.QPKT CNT, 

é QPKT_IDX,REM_CNT,REM_IDX,NUMREM-BFRS,GPFCAG, 
LASTBFR, EOF FLAG, ERRFLAG, REMFLAG 


INTEGER*®4 SYSSSETEF 


' 

' 

' 

' 
INTEGER*®4 CSTATUS ' Common status 
INTEGER®4 LASTBFRSIZ ' Last buffer size 
INTEGER*®4 DDIDIS ' DDI disable 
old 5 MRMS_CNT ' Master RMS count 
INTEGER*2 MRMS_iDX ! Master RMS index 
re arnes QPKT_CNT ' Queue packet count 
INTEGER*2 QPKT_IDX ' Queue packet index 
INTEGER*2 REM_CNT ! Remote buffer count 
INTEGER*2 REM IDX ' Remote buffer index 
INTEGER*2 NUMREM_BFRS ' Number of remote buffers 
LOGICAL*®1 GPFLAG Get/put flag 

' 

' 

! 


DO 100 I = 1,6 
FILEATTR(I) = IDEVMSG(1+2) 
CONT INUE 


STATUS = SYSSSETEF (2VAL(2)) 
IF (.NOT. STATUS) CALL FATAL_ERROR(STATUS) 


RETURN 
END 


—————————_——- 


7 
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SUBROUTINE MFQ_PNXTBFR 


Common variables and areas 
INTEGER®4 peeves te ) 


— 
r 4 
— 
m 
a 
mm 
»@ 
@ 
© 
mov orue 
zzz 
— 
o 
z 
— 


LOGICAL*1 REMFLAG 
COMMON /MDATA/ IDEVMSG,ODEVMSG 
2 QPKT_IDX,REM 


IF CERRFLAG) RETURN : 


to the DR32. 


REM_CNT = REM_CNT +1 
IF TOPKT_CNT 7GT. 0) CALL QUEUE_PKT 


RETURN 
END 


This subroutine is called when the slave sends a message 
indicating that it has processed its next buffer. 


! Incoming device messages 
! Gutgoing device messages 
! Remote bu 

' File attributes 

' Common status 

' Last buffer size 

! DDI disable 

! Master RMS count 

' Master RMS index 

' Queue packet count 

' Queue packet index 

' Remote buffer count 

' Remote buffer index 

' Number of remote buffers 
! Get/put flag 

! Last buffer flag 

! End of file flag 

! Error flag 

! Remote error flag 


REM_BFRADS,F ILEATTR, CSTATUS 

LASTBFRSIZ,DDIDIS,MRMS_CNT.MRMS IDX.QPKT CNT, 
CNT,REM_IBa,N 

3 LASTBFR,EOFFCAG,ERRFLAG,REMFLAG 


ffer addresses 


UMREM~BFRS,GPFCAG, 


Return if ERRFLAG is set 


Increment the number of remote buffers available. If 
we have a matching local buffer, then queue an operation 


POQOOOVOAOAOOAOAOOVOOAAIAIAIOAAAIOAIL 


OOO AOOOan 


Oona 


OOOL 


DRMASTER.FOR; 1 


SUBROUTINE MFQ_PLSTBFR 


This routine is called when the slave send 
indicating that it has processed its last 


Local Variables 
INTEGER®4 STATUS 


Common variables and areas 
INTEGER*®4 JOE NSS Cee? 


© 

wv 

x 

“— 

— 

i eT ee A ee A) 
x4OoZ Onoawa 

4 z2a>Po~ 

“~~ 


LOGICAL*1 REMFLAG 


ie. 
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& message 
bul fer. 


! Incoming device messages 
; Renate 6 device messages 
! Remote bu 


ffer addresses 
File attributes 


' Common status 

' Last buffer size 

! DDI disable 

' Master RMS count 

' Master RMS index 

' Queue packet count 
' Queue packet index 
' Remote buffer count 
' Remote buffer index 
' Number of remote buffers 
! Get/put flag 


Last buffer flag 


i End of file flag 
' Error flag 
! Remote error flag 


COMMON /MDATA/ IDE VSG ODE VSG REM_BFRADS,FILEATTR, csTATus 

1 FRSIZ 1pis MRMS ‘ T. Dx CNT, 

g Leet Oro veme 1 Re M_1BX,NUMREM “BFR. GPrAc,” 
LASTBFR, ECFFCAG. ERRFCAG. REMFLAG 


INTEGER®4 SYSSSETEF 
EXTERNAL SS$_NORMAL 
IF (ERRFLAG) RETURN 


If this is a GET then we have to read the 
this is a PUT, then we are all done. 


IF (GPFLAG .€Q. 1) THEN 
EOFFLAG = .TRU 
LASTBFRSIZ. = IbEwmse¢2) 

IF TQPKT_CNT =GT. 0) CALL QUEUE_PKT 

CSTATUS = ZLOC(SS$_NORMAL) 


Return if ERRFLAG is set 
last buffer. If 


Doing a GET 

Set Gnd of file flag 
Save last buffer size 
Inc. remote bfr count 
Queue a foes if possible 


! Doing a PU 
' Set success status 


C 
C s 
C 


DRMASTER.FOR; 1 
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! Wake up main level 
L_ERROR(STATUS) 


OO” 


, 
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OOO COOOon 


OO 


OOo 


SUBROUTINE MFQ_ERROR 


This subroutine is called when the remote system sends 
an error message 


Local Variables 
INTEGER®4 STATUS 


Common variables and areas 
INTEGER*®4 IDEVMSG(32) ! Incoming device messages 
: ok ag device messages 
' Remote buffer addresses 
! File attributes 

: Common status— 

' Last buffer size 

' DDI disable 

' Master RMS count 

' Master RMS index 

' Queue packet count 

' Queue packet index 

! Remote buffer count 


INTEGER*®4 CSTATUS 


seh Sa REM ' Remote buffer index 
INTEGER*® Ms ! Number of remote buffers 
LOGICAL*1 ! Get/put flag 


LOGICAL®1 LASTBFR 
LOGICAL*1 EOFFLAG 
LOGICAL®1 ERRFLAG ! Error flag 

LOGICAL*1 REMFLAG ! Remote error flag 


COMMON /MDATA/ IDEVMSG,ODEVMSG,REM_BFRADS,FILEATTR,CSTATUS 
1 LASTBFRS1Z,DDIDIS,MRMS_CNT.MRMS IDX.QPKT CNT, 


' Last buffer flag 
' End of file flag 


om 

z 

—_ 

m 

a 

m 

P ] 

= 

Lass] 
a ozzo 
VoOmMmMvVDZDO 
“SBBAXKBIZe 

~ 

oO 

z 

—_ 


2 GPKT_IDX,REM_CNT,REM_IDX,NUMREM-BFRS,GPFCAG, 

3 LASTBFR, EOF FLAG, ERRFCAG, REMFLAG 

INTEGER®4 SYSS$SETEF 

ERRFLAG = .TRUE. ! Set error flag 
REMFLAG = .TRUE. ' Set remote error flag 
CSTATUS = IDEVMSG(2) ' Get error status 


Set event flags 1 and 2 and conditionally 3 
STATUS = SYSSSETEF(ZVAL(1)) 

IF (.NOT. STATUS)CALL FATAL_ERROR(STATUS) 
STATUS = SYSSSETEF (ZVAL(2)) 

IF (.NOT. STATUS) CALL FATAL_ERROR(STATUS) 


IF (GPFLAG.EQ.1 .AND. MRMS_CNT .EQ. -1) ! Get 


C 
C 
C 


DRMASTER.FOR; 1 
STATUS = aN. 
I thee EQ. D. 
STATUS = SYSSSET 
if ¢. NOT. StAtUs) CAL 
RETURN 
END 
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' Put 
OR(STATUS) 


C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 


H 7 
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SUBROUTINE ERROR(CSTATUS,REMFLAG) 


This routine prints error messages and returns. If REMFLAG 
is set the error message is preceded by a message saying 
that the error is from the remote system. 


AOOOLN 


INTEGER*2 LENGTH 
INTEGER*®4 STATUS, CSTATUS 
LOGICAL REMFLAG 
CHARACTER®256 MSGBFR 
INTEGER®4 SYSS$SGETMSG 
IF (REMFLAG) WRITE(6,100) 
100 FORMAT(1X,*ZDRCOPY-E-REMERROR, error from remote system:') 


STATUS=SYSS$GETMSG(ZVAL (CSTATUS) ,LENGTH,MSGBFR,ZVAL(15),) 
IF (.NOT. STATUS) CALL FATAL_ERROR (STATUS) 


WRITE (6,200) MSGBFR(1:LENGTH) 
200 FORMAT (1X,A) 


RETURN 
END 
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SUBROUTINE RMS_ERRORCISTATUS) 
This subroutine sends an error packet to the remote system. 


INCLUDE \ SYSSLIBRARY : XFDEF .FOR/NOLIST' ! DR32 definitions 
INCLUDE ‘DRCOPY.PRM/NOLIST ' Parameters 

Local Variables 

INTEGER*®4 ISTATUS,STATUS 


Common variables and areas 

INTEGER®4 XFDATA(30) 

BYTE MBFRS(BUFSIZ,NUM_MBFRS) 

BYTE SBFRS(BUFSIZ,NUM_SBFRS) 

COMMON /MS_SHARE/ XFDATA,MBFRS,SBFRS 


INTEGER*4 Brest 


Context array 
Master buffers 
Slave buffers 


! Incoming device messages 
: guteetne device messages 
' Remote ul yer addresses 
! File attributes 

' Common status 

' Last buffer size 

! DDI disable 

' Master RMS count 

' Master RMS index 

' Queue packet count 

' Queue packet index 

! Remote buffer count 

! Remote buffer index 

!' Number of remote buffers 
' Get/put flag 

' Last buffer flag 

! End of file flag 

! Error flag 

! Remote error flag 


— 
z 
— 
m 
oc 
m 
=» 
S 
o 
mov orue 
zzz 
~ 
o 
z 
—_ 


LOGICAL*1 REMFLAG 


COMMON /MDATA/ IDEVMSG ODE VMSG REM BERADS, FILEATTR, cstatus 

1 LASTBFRS1Z Dipts MRMS _C 1 ARNS 1DX cnt, 

é bPey IDX Feb? T,REM BK NUMRE aver RS, GPrAG.” 
LASTBFR, eee ERRFLAG. REMFLAG™ 


INTEGER*4 SYSS$SETEF 


ERRFLAG = .TRUE. ' Set error flag 
CSTATUS = ISTATUS ' Store status 
ODEVMSG(1) = 9 ! Message type 
ODEVMSG(2) = ISTATUS ' Status 


DR' 


POAAOAAAAIAMAAAMAOS 


COO 


SOON 
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ALL schastabeeste” 4 ~ jj ' Send packet 
XFSK_PKT_WRTCM,,, ' Func.,index,size 
ODEVASG,8,, ' msg. size, og area : 
° ' Int. if Q@ empty, no action routine 
STATUS) i Status 
IF (.NOT. STATUS) CALL FATAL_ERROR(STATUS) 


STATUS=SYSSSETEF (2VAL(3)) ' Wake up main level 
IF (.NOT. STATUS) CALL FATAL_ERROR(STATUS) 


RETURN 
END 


Fun OO 


DR' 


kK 7 
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SUBROUTINE DR32_ERROR 


This subroutine prints the 1/0 status block for DR32 errors 
Note that this routine does not return 


COOOL 


INCLUDE ‘DRCOPY.PRM/NOLIST' ' Parameters 


Common variables and areas 


Oona 


INTEGER®4 XFDATA(30) ! Context array 
BYTE MBFRS(BUFSIZ,NUM_MBFRS) i Master buffers 
BYTE SBFRS(BUFSIZ,NUM_SBFRS) i Slave buffers 


COMMON /MS_SHARE/ XFDATA,MBFRS,SBFRS 
INTEGER*4 10SB(2) 
EQUIVALENCE (10SB,XFDATA) 


WRITE (6,100) 
100 FORMAT (1x SEORCOPY“F-DR3ZERR, DR32 error’) 
ORITEG 269) 10 B(2) 
200 FORMAT (1x oa 255 ',78," (Hex)*) 
CALL Uiesgtopcewat (10s8e45)) 


AOMOAOAOMOOOAMAOAOOOOMN 


OO 


On 
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SUBROUTINE FATAL_ERROR(STATUS) 
This routine signals fatal errors and exits 


INTEGER®4 STATUS 
cat LIBSSTOP(ZVAL (STATUS) ) 
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